home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / PRG / MacPerl 506 appl folder.sit / MacPerl 506 appl folder / Mac_Perl_506r1m_appl / lib / File / Find.pm < prev    next >
Text File  |  1995-03-20  |  6KB  |  242 lines
  1. package File::Find;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. @ISA = qw(Exporter);
  6. @EXPORT = qw(find finddepth);
  7.  
  8. # Usage:
  9. #    use File::Find;
  10. #
  11. #    find(¥&wanted, '/foo','/bar');
  12. #
  13. #    sub wanted { ... }
  14. #        where wanted does whatever you want.  $dir contains the
  15. #        current directory name, and $_ the current filename within
  16. #        that directory.  $name contains "$dir/$_".  You are cd'ed
  17. #        to $dir when the function is called.  The function may
  18. #        set $prune to prune the tree.
  19. #
  20. # This library is primarily for find2perl, which, when fed
  21. #
  22. #   find2perl / -name .nfs¥* -mtime +7 -exec rm -f {} ¥; -o -fstype nfs -prune
  23. #
  24. # spits out something like this
  25. #
  26. #    sub wanted {
  27. #        /^¥.nfs.*$/ &&
  28. #        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  29. #        int(-M _) > 7 &&
  30. #        unlink($_)
  31. #        ||
  32. #        ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  33. #        $dev < 0 &&
  34. #        ($prune = 1);
  35. #    }
  36. #
  37. # Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
  38.  
  39. $dont_use_nlink = 1;
  40.  
  41. sub find {
  42.     my $wanted = shift;
  43.     chop($cwd = `pwd`);
  44.     foreach $topdir (@_) {
  45.     (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
  46.       || (warn("Can't stat $topdir: $!¥n"), next);
  47.     if (-d _) {
  48.         if (chdir($topdir)) {
  49. #        ($dir,$_) = ($topdir,'.');
  50.         ($dir,$_) = ($topdir,':');
  51.         $name = $topdir;
  52.         &$wanted;
  53. #        ($fixtopdir = $topdir) =~ s,/$,, ;
  54.         ($fixtopdir = $topdir) =~ s,:$,, ;
  55.         &finddir($wanted,$fixtopdir,$topnlink);
  56.         }
  57.         else {
  58.         warn "Can't cd to $topdir: $!¥n";
  59.         }
  60.     }
  61.     else {
  62. #        unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
  63. #        ($dir,$_) = ('.', $topdir);
  64.         unless (($dir,$_) = $topdir =~ m#^(.*:)(.*)$#) {
  65.         ($dir,$_) = (':', $topdir);
  66.         }
  67.         $name = $topdir;
  68.         chdir $dir && &$wanted;
  69.     }
  70.     chdir $cwd;
  71.     }
  72. }
  73.  
  74. sub finddir {
  75.     local($wanted,$dir,$nlink) = @_;
  76.     local($dev,$ino,$mode,$subcount);
  77.     local($name);
  78.  
  79.     # Get the list of files in the current directory.
  80.  
  81. #    opendir(DIR,'.') || (warn "Can't open $dir: $!¥n", return);
  82.     opendir(DIR,':') || (warn "Can't open $dir: $!¥n", return);
  83.     local(@filenames) = readdir(DIR);
  84.     closedir(DIR);
  85.  
  86.     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
  87.     for (@filenames) {
  88. #        next if $_ eq '.';
  89. #        next if $_ eq '..';
  90. #        $name = "$dir/$_";
  91.         $name = "$dir:$_";
  92.         $nlink = 0;
  93.         &$wanted;
  94.     }
  95.     }
  96.     else {                    # This dir has subdirectories.
  97.     $subcount = $nlink - 2;
  98.     for (@filenames) {
  99. #        next if $_ eq '.';
  100. #        next if $_ eq '..';
  101.         $nlink = $prune = 0;
  102. #        $name = "$dir/$_";
  103.         $name = "$dir:$_";
  104.         &$wanted;
  105.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  106.  
  107.         # Get link count and check for directoriness.
  108.  
  109.         ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
  110.         
  111.         if (-d _) {
  112.  
  113.             # It really is a directory, so do it recursively.
  114.  
  115.             if (!$prune && chdir $_) {
  116.             &finddir($wanted,$name,$nlink);
  117. #            chdir '..';
  118.             chdir '::';
  119.             }
  120.             --$subcount;
  121.         }
  122.         }
  123.     }
  124.     }
  125. }
  126.  
  127. # Usage:
  128. #    use File::Find;
  129. #
  130. #    finddepth(¥&wanted, '/foo','/bar');
  131. #
  132. #    sub wanted { ... }
  133. #        where wanted does whatever you want.  $dir contains the
  134. #        current directory name, and $_ the current filename within
  135. #        that directory.  $name contains "$dir/$_".  You are cd'ed
  136. #        to $dir when the function is called.  The function may
  137. #        set $prune to prune the tree.
  138. #
  139. # This library is primarily for find2perl, which, when fed
  140. #
  141. #   find2perl / -name .nfs¥* -mtime +7 -exec rm -f {} ¥; -o -fstype nfs -prune
  142. #
  143. # spits out something like this
  144. #
  145. #    sub wanted {
  146. #        /^¥.nfs.*$/ &&
  147. #        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  148. #        int(-M _) > 7 &&
  149. #        unlink($_)
  150. #        ||
  151. #        ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  152. #        $dev < 0 &&
  153. #        ($prune = 1);
  154. #    }
  155.  
  156. sub finddepth {
  157.     my $wanted = shift;
  158.     chop($cwd = `pwd`);
  159.     foreach $topdir (@_) {
  160.     (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
  161.       || (warn("Can't stat $topdir: $!¥n"), next);
  162.     if (-d _) {
  163.         if (chdir($topdir)) {
  164. #        ($fixtopdir = $topdir) =~ s,/$,, ;
  165.         ($fixtopdir = $topdir) =~ s,:$,, ;
  166.         &finddepthdir($wanted,$fixtopdir,$topnlink);
  167. #        ($dir,$_) = ($fixtopdir,'.');
  168.         ($dir,$_) = ($fixtopdir,':');
  169.         $name = $fixtopdir;
  170.         &$wanted;
  171.         }
  172.         else {
  173.         warn "Can't cd to $topdir: $!¥n";
  174.         }
  175.     }
  176.     else {
  177.         unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
  178. #        ($dir,$_) = ('.', $topdir);
  179.         ($dir,$_) = (':', $topdir);
  180.         }
  181.         chdir $dir && &$wanted;
  182.     }
  183.     chdir $cwd;
  184.     }
  185. }
  186.  
  187. sub finddepthdir {
  188.     my($wanted,$dir,$nlink) = @_;
  189.     my($dev,$ino,$mode,$subcount);
  190.     my($name);
  191.  
  192.     # Get the list of files in the current directory.
  193.  
  194. #    opendir(DIR,'.') || warn "Can't open $dir: $!¥n";
  195.     opendir(DIR,':') || warn "Can't open $dir: $!¥n";
  196.     my(@filenames) = readdir(DIR);
  197.     closedir(DIR);
  198.  
  199.     if ($nlink == 2 && !$dont_use_nlink) {        # This dir has no subdirectories.
  200.     for (@filenames) {
  201. #        next if $_ eq '.';
  202. #        next if $_ eq '..';
  203. #        $name = "$dir/$_";
  204.         $name = "$dir:$_";
  205.         $nlink = 0;
  206.         &$wanted;
  207.     }
  208.     }
  209.     else {                    # This dir has subdirectories.
  210.     $subcount = $nlink - 2;
  211.     for (@filenames) {
  212. #        next if $_ eq '.';
  213. #        next if $_ eq '..';
  214.         $nlink = $prune = 0;
  215. #        $name = "$dir/$_";
  216.         $name = "$dir:$_";
  217.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  218.  
  219.         # Get link count and check for directoriness.
  220.  
  221.         ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
  222.         
  223.         if (-d _) {
  224.  
  225.             # It really is a directory, so do it recursively.
  226.  
  227.             if (!$prune && chdir $_) {
  228.             &finddepthdir($wanted,$name,$nlink);
  229. #            chdir '..';
  230.             chdir '::';
  231.             }
  232.             --$subcount;
  233.         }
  234.         }
  235.         &$wanted;
  236.     }
  237.     }
  238. }
  239.  
  240. 1;
  241.  
  242.